En esta práctica se elabora un caso práctico orientado a aprender a identificar los datos relevantes para un proyecto analítico y usar las herramientas de integración, limpieza, validación y análisis de los mismos.
● Aprender a aplicar los conocimientos adquiridos y su capacidad de resolución de problemas en entornos nuevos o poco conocidos dentro de contextos más amplios o multidisciplinares.
● Saber identificar los datos relevantes y los tratamientos necesarios (integración, limpieza y validación) para llevar a cabo un proyecto analítico.
● Aprender a analizar los datos adecuadamente para abordar la información contenida en los datos.
● Identificar la mejor representación de los resultados para aportar conclusiones sobre el problema planteado en el proceso analítico.
● Actuar con los principios éticos y legales relacionados con la manipulación de datos en función del ámbito de aplicación.
● Desarrollar las habilidades de aprendizaje que les permitan continuar estudiando de un modo que tendrá que ser en gran medida autodirigido o autónomo.
● Desarrollar la capacidad de búsqueda, gestión y uso de información y recursos en el ámbito de la ciencia de datos.
A continuación, realizamos la descripción de las variables que hay en el dataset “Heart Attack Analysis & Prediction dataset”, usando la información encontrada en la web [Kaggle datasets] (https://www.kaggle.com/datasets), concretamente en el siguiente enlace: https://www.kaggle.com/datasets/rashikrahmanpritom/heart-attack-analysis-prediction-dataset
** Características de las variales incluidas:**
age: Edad del paciente
sex : Sexo del paciente (F=0; M=1)
cp : Tipo dolor torácico
Value 1 : Angina típica (TA)
Value 2 : Angina atípica (ATA)
Value 3 : Dolor no-anginal (NAP)
Value 4 : Asintomático (ASY)
trtbps : Presión arterial en reposo (in mm Hg)
chol : Colesterol en mg/dl obtenido a través del sensor de IMC
fbs : (Glucemia en ayunas > 120 mg/dl) (1 = true; 0 = false)
restecg : Resultados del electrocardiograma en reposo
Value 0 : Normal
Value 1 : Presentar anomalías de la onda ST-T (inversión de la onda T y/o elevación o depresión del ST de > 0,05 mV)
Value 2 : Hipertrofia ventricular izquierda probable o definida según los criterios de Estes
thalachh : Frecuencia cardiaca máxima alcanzada
exng : Angina inducida por esfuerzo (1 = yes; 0 = no)
oldpeak : Pico previo
slp : Pendiente del segmento ST máximo del ejercicio
caa : Número de buques principales (0-3)
thall : Tasa de mortalidad
output : 0= menor probabilidad de infarto 1= mayor probabilidad de infarto
Primero de todo, cargamos las librerías que vamos a usar durante la práctica
if (!require('csv')) install.packages('csv');library(csv)
if (!require('dplyr')) install.packages('dplyr');library(dplyr)
if (!require('ggplot2')) install.packages('ggplot2');library(ggplot2)
if (!require('reshape')) install.packages('reshape');library(reshape)
if (!require('plotly')) install.packages('plotly');library(plotly)
if (!require('plyr')) install.packages('plyr');library(plyr)
if (!require('Stat2Data')) install.packages('Stat2Data');library(Stat2Data)
if (!require('corrplot')) install.packages('corrplot');library(corrplot)
if (!require('Matrix')) install.packages('matrix');library(Matrix)
if (!require('patchwork')) install.packages('patchwork');library(patchwork)
if (!require('ggcorrplot')) install.packages('ggcorrplot');library(ggcorrplot)
if (!require('corrplot')) install.packages('ggcorrplot');library(corrplot)
if (!require('DataExplorer'))install.packages('DataExplorer');library(DataExplorer)
if (!require('psych'))install.packages('psych');library(psych)
if (!require('highcharter'))install.packages('highcharter');library(highcharter)
if (!require('tidyverse'))install.packages('tidyverse');library(tidyverse)
if (!require('GGally'))install.packages('GGally');library(GGally)
if (!require('htmltools'))install.packages('htmltools');library(htmltools)
# setwd
dir <- dirname(rstudioapi::getSourceEditorContext()$path)
setwd(dir)
Cargamos los datos de la base de datos “heart” y tipificamos las variables que tiene el conjunto de datos como corresponde
library(csv)
heart <- read.csv("heart.csv", header=T,sep=",")
# Mostramos los primeros registros del conjunto de dtos, con el fin de ver una aproximación de como es el conjunto y su estructura
head(heart, max(10))
## age sex cp trtbps chol fbs restecg thalachh exng oldpeak slp caa thall
## 1 63 1 3 145 233 1 0 150 0 2.3 0 0 1
## 2 37 1 2 130 250 0 1 187 0 3.5 0 0 2
## 3 41 0 1 130 204 0 0 172 0 1.4 2 0 2
## 4 56 1 1 120 236 0 1 178 0 0.8 2 0 2
## 5 57 0 0 120 354 0 1 163 1 0.6 2 0 2
## 6 57 1 0 140 192 0 1 148 0 0.4 1 0 1
## 7 56 0 1 140 294 0 0 153 0 1.3 1 0 2
## 8 44 1 1 120 263 0 1 173 0 0.0 2 0 3
## 9 52 1 2 172 199 1 1 162 0 0.5 2 0 3
## 10 57 1 2 150 168 0 1 174 0 1.6 2 0 2
## output
## 1 1
## 2 1
## 3 1
## 4 1
## 5 1
## 6 1
## 7 1
## 8 1
## 9 1
## 10 1
str(heart)
## 'data.frame': 303 obs. of 14 variables:
## $ age : int 63 37 41 56 57 57 56 44 52 57 ...
## $ sex : int 1 1 0 1 0 1 0 1 1 1 ...
## $ cp : int 3 2 1 1 0 0 1 1 2 2 ...
## $ trtbps : int 145 130 130 120 120 140 140 120 172 150 ...
## $ chol : int 233 250 204 236 354 192 294 263 199 168 ...
## $ fbs : int 1 0 0 0 0 0 0 0 1 0 ...
## $ restecg : int 0 1 0 1 1 1 0 1 1 1 ...
## $ thalachh: int 150 187 172 178 163 148 153 173 162 174 ...
## $ exng : int 0 0 0 0 1 0 0 0 0 0 ...
## $ oldpeak : num 2.3 3.5 1.4 0.8 0.6 0.4 1.3 0 0.5 1.6 ...
## $ slp : int 0 0 2 2 2 1 1 2 2 2 ...
## $ caa : int 0 0 0 0 0 0 0 0 0 0 ...
## $ thall : int 1 2 2 2 2 1 2 3 3 2 ...
## $ output : int 1 1 1 1 1 1 1 1 1 1 ...
# Obtener la cantidad de filas y columnas
dimensiones <- dim(heart)
num_filas <- dimensiones[1]
num_columnas <- dimensiones[2]
# Imprimir el mensaje
mensaje <- paste("El conjunto tiene", num_filas, "filas y", num_columnas, "columnas.")
print(mensaje)
## [1] "El conjunto tiene 303 filas y 14 columnas."
# Obtenemos un primer vistazo estadístico de cada atirbuto
describeBy(heart)
## Warning in describeBy(heart): no grouping variable requested
## vars n mean sd median trimmed mad min max range skew
## age 1 303 54.37 9.08 55.0 54.54 10.38 29 77.0 48.0 -0.20
## sex 2 303 0.68 0.47 1.0 0.73 0.00 0 1.0 1.0 -0.78
## cp 3 303 0.97 1.03 1.0 0.86 1.48 0 3.0 3.0 0.48
## trtbps 4 303 131.62 17.54 130.0 130.44 14.83 94 200.0 106.0 0.71
## chol 5 303 246.26 51.83 240.0 243.49 47.44 126 564.0 438.0 1.13
## fbs 6 303 0.15 0.36 0.0 0.06 0.00 0 1.0 1.0 1.97
## restecg 7 303 0.53 0.53 1.0 0.52 0.00 0 2.0 2.0 0.16
## thalachh 8 303 149.65 22.91 153.0 150.98 22.24 71 202.0 131.0 -0.53
## exng 9 303 0.33 0.47 0.0 0.28 0.00 0 1.0 1.0 0.74
## oldpeak 10 303 1.04 1.16 0.8 0.86 1.19 0 6.2 6.2 1.26
## slp 11 303 1.40 0.62 1.0 1.46 1.48 0 2.0 2.0 -0.50
## caa 12 303 0.73 1.02 0.0 0.54 0.00 0 4.0 4.0 1.30
## thall 13 303 2.31 0.61 2.0 2.36 0.00 0 3.0 3.0 -0.47
## output 14 303 0.54 0.50 1.0 0.56 0.00 0 1.0 1.0 -0.18
## kurtosis se
## age -0.57 0.52
## sex -1.39 0.03
## cp -1.21 0.06
## trtbps 0.87 1.01
## chol 4.36 2.98
## fbs 1.88 0.02
## restecg -1.37 0.03
## thalachh -0.10 1.32
## exng -1.46 0.03
## oldpeak 1.50 0.07
## slp -0.65 0.04
## caa 0.78 0.06
## thall 0.25 0.04
## output -1.97 0.03
Primero de todo, hacemos una matriz de correlaciones de todo el conjunto, para ver como son los datos
library(corrplot)
# Convirtimos todas las variables a numéricas (asegúrate de que las variables sean numéricas)
heart_numeric <- sapply(heart, as.numeric)
# Calculamos la matriz de correlación
correlation_tab <- cor(heart_numeric)
library(RColorBrewer)
# Definimos una nueva paleta de colores
new_col <- colorRampPalette(c("#0000CD", "#7D26CD", "#FFFFFF","#FF6347","#FF0000"))
# Crear la matriz de correlación con corrplot y personalización adicional
corrplot(correlation_tab,
method = "color",
tl.col = "black",
tl.srt = 30,
tl.cex = 0.6,
cl.cex = 0.6,
col = new_col(200),
addCoef.col = "black",
order = "AOE",
number.cex = 0.6)
Observaciones Según la matriz de correlaciones inicial,
presentada anteriormente, donde las correlaciones positivas se muestran
en color rojo y las negativas en color azul fuerte podemos ver cuales
son las variables con mayores intensidad de color, guiando así la
significación de los coeficientes de correlación.
Debido que algunas de las variables del conjunto de datos tienen tipos de datos incorrectos, debemos transformar los tipos de datos antes del análisis
# Clasificamos las variables en numéricas o en categóricas
# Numéricas
heart <- heart%>%
mutate_at(vars(age,trtbps,chol, thalachh, oldpeak), as.numeric)
# Categóricas
heart <- heart%>%
mutate_at(vars(sex, cp, fbs, restecg, exng, slp, thall, caa, output), as.factor)
introduce(heart)
## rows columns discrete_columns continuous_columns all_missing_columns
## 1 303 14 9 5 0
## total_missing_values complete_rows total_observations memory_usage
## 1 0 303 4242 31880
Según la tabla y el barplot creado, podemos ver como el conjunto de datos heart tiene 14 atributos y 303 observaciones, y contiene un total de 9 columnas discretas y 5 columnas continuas.
Con la librería DataExplorer vemos una vista general del conjunto de datos de análisis una vez seleccionados, basandonos en los valores faltantes, columnas discretas y continuas.
plot_intro(heart, title = "Información Dataset")
Tal y como vemos en el barplot creado, podemos ver la distirbución del
conjunto como en la tabla anterior y también observamos como no hay
valores faltantes.
Ahora vamos a visualizar la información básica del conjunto de datos en función de la variable ‘output’ de interés
# La variable output nos va indicar quien tiene o no una mayor probabilidad de sufrir un ataque al corazón, por lo que primero calculamos el porcentaje de pacientes que tienen mayor probabilidad y luego el resto
print("Porcentaje de personas con probabilidad de infarto")
## [1] "Porcentaje de personas con probabilidad de infarto"
round((sum(heart$output == 1)/nrow(heart)) * 100, 2)
## [1] 54.46
print("Porcentaje de personas sin probabilidad de infarto")
## [1] "Porcentaje de personas sin probabilidad de infarto"
round((sum(heart$output == 0)/nrow(heart))*100,2)
## [1] 45.54
# Valores duplicados
get_duplicates <- function(heart){
total_rows = dim(heart)[1]
unique_rows = dim(heart %>% group_by_all %>% count)[1]
n_duplicates = (total_rows - unique_rows)
cat('n duplicates -> ', n_duplicates)
}
get_duplicates(heart) # Vemos que hay un valor duplicado
## n duplicates -> 1
heart = unique(heart)
cat('Eliminamos la fila duplicada')
## Eliminamos la fila duplicada
get_duplicates(heart)
## n duplicates -> 0
Ya no tenemos valores duplicados en el conjunto de datos
Seguidamente es importante estudiar la posibilidad de valores outliers para las variables numéricas de la base de datos
# Cargamos librerías necesarias
library(ggplot2)
# Reorganizamos el dataframe para plotear las variables seleccionadas
selected_vars <- heart[, c("age", "oldpeak", "chol", "thalachh", "trtbps")]
selected_vars <- stack(selected_vars)
# Agregamos la columna 'output' al dataframe para usarla en el color de los puntos
selected_vars$output <- heart$output
# Creamos un gráfico de cajas con puntos superpuestos para las variables numéricas seleccionadas
ggplot(selected_vars, aes(x = ind, y = values, color = as.factor(output))) +
geom_boxplot(alpha = 0.7, outlier.size = 2) +
geom_jitter(alpha = 0.3, size = 0.5) +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(x = "Variables", y = "Valores") +
scale_color_brewer(palette = "Set1", name = "Probabilidad de Infarto", labels = c('0 - Menor Probabilidad', '1 - Mayor Probabilidad')) +
ggtitle("Gráfico de Cajas con Puntos - Variables Numéricas y Outliers")
Observaciones Podemos ver como hay puntos muy alejados
de las medias y de los boxplots creados en las variables chol, thalachh
y trtbps, por lo que, vamos a estudiar si mediante una función creada
según las desviaciones estandard, se eliminan estos valores y dejamos el
conjunto de datos sin potenciales valores outliers.
Para limpiar los valores atípicos (outliers) usamos un enfoque del rango intercuartílico (IQR), el cual es una medida de dispersión que se bada en la diferencia entre el tercer (Q3) y primer cuartil (Q1) del conjunto de datos
# Creamos un dataframe de las variables de las cuales hemos de quitar outliers, excluyendo age y oldpeak
df_outliers<-as.data.frame(heart %>%
select("trtbps","thalachh","chol"))
# Función para quitar outliers
outliers <- function(x) {
# IQR
Q1 <- quantile(x, probs=.25)
Q3 <- quantile(x, probs=.75)
iqr = Q3-Q1
# Rango Superior
upper_limit = Q3 + (iqr*1.5)
# Rango Inferior
lower_limit = Q1 - (iqr*1.5)
x > upper_limit | x < lower_limit
}
# Quitamos valores atípicos
remove_outliers <- function(df_outliers, cols = names(df_outliers)) {
for (col in cols) {
df_outliers<- df_outliers[!outliers(df_outliers[[col]]),]
}
df_outliers
}
# Una vez creada la función para quitar los outliers, creamos un nuevo conjutno de datos sin los outliers
heart_clean<-remove_outliers(heart,c("trtbps","thalachh", "chol"))
# Observamos el cambio de las dimensiones
dim(heart_clean)
## [1] 287 14
Los valores potenciales outliers han sido eliminados y ahora tenemos el conjunto de datos con un total de 287 filas y 14 variables.
Resultado de Limpieza de Outliers
# Reorganizamos el dataframe para plotear las variables seleccionadas
selected_vars <- heart_clean[, c("age", "oldpeak", "chol", "thalachh", "trtbps")]
selected_vars <- stack(selected_vars)
# Agregamos la columna 'output' al dataframe para usarla en el color de los puntos
selected_vars$output <- heart_clean$output
# Creamos un gráfico de cajas con puntos superpuestos para las variables numéricas seleccionadas
ggplot(selected_vars, aes(x = ind, y = values, color = as.factor(output))) +
geom_boxplot(alpha = 0.7, outlier.size = 2) +
geom_jitter(alpha = 0.3, size = 0.5) +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(x = "Variables", y = "Valores") +
scale_color_brewer(palette = "Set1", name = "Probabilidad de Infarto", labels = c('0 - Menor Probabilidad', '1 - Mayor Probabilidad')) +
ggtitle("Gráfico de Cajas con Puntos - Variables Numéricas y Outliers")
Para evaluar la normalidad de las variables seleccionadas, empleamos la prueba de Spahiro-Wilk
# Usamos la prueba de Shapiro-Wilk para verificar la normalidad de cada variable numérica
variables <- c("age", "trtbps", "chol", "thalachh", "oldpeak")
resultados_shapiro <- lapply(heart_clean[variables], shapiro.test)
names(resultados_shapiro) <- variables
# Verificar la estructura de las variables seleccionadas en el conjunto de datos 'heart'
str(heart_clean[, variables])
## 'data.frame': 287 obs. of 5 variables:
## $ age : num 63 37 41 56 57 57 56 44 57 54 ...
## $ trtbps : num 145 130 130 120 120 140 140 120 150 140 ...
## $ chol : num 233 250 204 236 354 192 294 263 168 239 ...
## $ thalachh: num 150 187 172 178 163 148 153 173 174 160 ...
## $ oldpeak : num 2.3 3.5 1.4 0.8 0.6 0.4 1.3 0 1.6 1.2 ...
# Mostramos los resultados
print(resultados_shapiro)
## $age
##
## Shapiro-Wilk normality test
##
## data: X[[i]]
## W = 0.98804, p-value = 0.0179
##
##
## $trtbps
##
## Shapiro-Wilk normality test
##
## data: X[[i]]
## W = 0.98405, p-value = 0.002776
##
##
## $chol
##
## Shapiro-Wilk normality test
##
## data: X[[i]]
## W = 0.99285, p-value = 0.1856
##
##
## $thalachh
##
## Shapiro-Wilk normality test
##
## data: X[[i]]
## W = 0.97557, p-value = 8.092e-05
##
##
## $oldpeak
##
## Shapiro-Wilk normality test
##
## data: X[[i]]
## W = 0.84178, p-value < 2.2e-16
Los resultados de la normalidad muestran que para cada una de las variables numéricas del conjunto de datos, excepto la variable chol, hay evidencia suficiente para rechazar la hipótesis nula y afirmar que los datos no siguen una distribución normal, pero como las observaciones son mayores a 30 se puede asumir.
Normalizamos los datos A cotninuación normalizamos los datos con valores entre -1 y 1 para poder hacer análisis posteriores
heart_clean
## age sex cp trtbps chol fbs restecg thalachh exng oldpeak slp caa thall
## 1 63 1 3 145 233 1 0 150 0 2.3 0 0 1
## 2 37 1 2 130 250 0 1 187 0 3.5 0 0 2
## 3 41 0 1 130 204 0 0 172 0 1.4 2 0 2
## 4 56 1 1 120 236 0 1 178 0 0.8 2 0 2
## 5 57 0 0 120 354 0 1 163 1 0.6 2 0 2
## 6 57 1 0 140 192 0 1 148 0 0.4 1 0 1
## 7 56 0 1 140 294 0 0 153 0 1.3 1 0 2
## 8 44 1 1 120 263 0 1 173 0 0.0 2 0 3
## 10 57 1 2 150 168 0 1 174 0 1.6 2 0 2
## 11 54 1 0 140 239 0 1 160 0 1.2 2 0 2
## 12 48 0 2 130 275 0 1 139 0 0.2 2 0 2
## 13 49 1 1 130 266 0 1 171 0 0.6 2 0 2
## 14 64 1 3 110 211 0 0 144 1 1.8 1 0 2
## 15 58 0 3 150 283 1 0 162 0 1.0 2 0 2
## 16 50 0 2 120 219 0 1 158 0 1.6 1 0 2
## 17 58 0 2 120 340 0 1 172 0 0.0 2 0 2
## 18 66 0 3 150 226 0 1 114 0 2.6 0 0 2
## 19 43 1 0 150 247 0 1 171 0 1.5 2 0 2
## 20 69 0 3 140 239 0 1 151 0 1.8 2 2 2
## 21 59 1 0 135 234 0 1 161 0 0.5 1 0 3
## 22 44 1 2 130 233 0 1 179 1 0.4 2 0 2
## 23 42 1 0 140 226 0 1 178 0 0.0 2 0 2
## 24 61 1 2 150 243 1 1 137 1 1.0 1 0 2
## 25 40 1 3 140 199 0 1 178 1 1.4 2 0 3
## 26 71 0 1 160 302 0 1 162 0 0.4 2 2 2
## 27 59 1 2 150 212 1 1 157 0 1.6 2 0 2
## 28 51 1 2 110 175 0 1 123 0 0.6 2 0 2
## 30 53 1 2 130 197 1 0 152 0 1.2 0 0 2
## 31 41 0 1 105 198 0 1 168 0 0.0 2 1 2
## 32 65 1 0 120 177 0 1 140 0 0.4 2 0 3
## 33 44 1 1 130 219 0 0 188 0 0.0 2 0 2
## 34 54 1 2 125 273 0 0 152 0 0.5 0 1 2
## 35 51 1 3 125 213 0 0 125 1 1.4 2 1 2
## 36 46 0 2 142 177 0 0 160 1 1.4 0 0 2
## 37 54 0 2 135 304 1 1 170 0 0.0 2 0 2
## 38 54 1 2 150 232 0 0 165 0 1.6 2 0 3
## 39 65 0 2 155 269 0 1 148 0 0.8 2 0 2
## 40 65 0 2 160 360 0 0 151 0 0.8 2 0 2
## 41 51 0 2 140 308 0 0 142 0 1.5 2 1 2
## 42 48 1 1 130 245 0 0 180 0 0.2 1 0 2
## 43 45 1 0 104 208 0 0 148 1 3.0 1 0 2
## 44 53 0 0 130 264 0 0 143 0 0.4 1 0 2
## 45 39 1 2 140 321 0 0 182 0 0.0 2 0 2
## 46 52 1 1 120 325 0 1 172 0 0.2 2 0 2
## 47 44 1 2 140 235 0 0 180 0 0.0 2 0 2
## 48 47 1 2 138 257 0 0 156 0 0.0 2 0 2
## 49 53 0 2 128 216 0 0 115 0 0.0 2 0 0
## 50 53 0 0 138 234 0 0 160 0 0.0 2 0 2
## 51 51 0 2 130 256 0 0 149 0 0.5 2 0 2
## 52 66 1 0 120 302 0 0 151 0 0.4 1 0 2
## 53 62 1 2 130 231 0 1 146 0 1.8 1 3 3
## 54 44 0 2 108 141 0 1 175 0 0.6 1 0 2
## 55 63 0 2 135 252 0 0 172 0 0.0 2 0 2
## 56 52 1 1 134 201 0 1 158 0 0.8 2 1 2
## 57 48 1 0 122 222 0 0 186 0 0.0 2 0 2
## 58 45 1 0 115 260 0 0 185 0 0.0 2 0 2
## 59 34 1 3 118 182 0 0 174 0 0.0 2 0 2
## 60 57 0 0 128 303 0 0 159 0 0.0 2 1 2
## 61 71 0 2 110 265 1 0 130 0 0.0 2 1 2
## 62 54 1 1 108 309 0 1 156 0 0.0 2 0 3
## 63 52 1 3 118 186 0 0 190 0 0.0 1 0 1
## 64 41 1 1 135 203 0 1 132 0 0.0 1 0 1
## 65 58 1 2 140 211 1 0 165 0 0.0 2 0 2
## 66 35 0 0 138 183 0 1 182 0 1.4 2 0 2
## 67 51 1 2 100 222 0 1 143 1 1.2 1 0 2
## 68 45 0 1 130 234 0 0 175 0 0.6 1 0 2
## 69 44 1 1 120 220 0 1 170 0 0.0 2 0 2
## 70 62 0 0 124 209 0 1 163 0 0.0 2 0 2
## 71 54 1 2 120 258 0 0 147 0 0.4 1 0 3
## 72 51 1 2 94 227 0 1 154 1 0.0 2 1 3
## 73 29 1 1 130 204 0 0 202 0 0.0 2 0 2
## 74 51 1 0 140 261 0 0 186 1 0.0 2 0 2
## 75 43 0 2 122 213 0 1 165 0 0.2 1 0 2
## 76 55 0 1 135 250 0 0 161 0 1.4 1 0 2
## 77 51 1 2 125 245 1 0 166 0 2.4 1 0 2
## 78 59 1 1 140 221 0 1 164 1 0.0 2 0 2
## 79 52 1 1 128 205 1 1 184 0 0.0 2 0 2
## 80 58 1 2 105 240 0 0 154 1 0.6 1 0 3
## 81 41 1 2 112 250 0 1 179 0 0.0 2 0 2
## 82 45 1 1 128 308 0 0 170 0 0.0 2 0 2
## 83 60 0 2 102 318 0 1 160 0 0.0 2 1 2
## 84 52 1 3 152 298 1 1 178 0 1.2 1 0 3
## 85 42 0 0 102 265 0 0 122 0 0.6 1 0 2
## 87 68 1 2 118 277 0 1 151 0 1.0 2 1 3
## 88 46 1 1 101 197 1 1 156 0 0.0 2 0 3
## 89 54 0 2 110 214 0 1 158 0 1.6 1 0 2
## 90 58 0 0 100 248 0 0 122 0 1.0 1 0 2
## 91 48 1 2 124 255 1 1 175 0 0.0 2 2 2
## 92 57 1 0 132 207 0 1 168 1 0.0 2 0 3
## 93 52 1 2 138 223 0 1 169 0 0.0 2 4 2
## 94 54 0 1 132 288 1 0 159 1 0.0 2 1 2
## 95 45 0 1 112 160 0 1 138 0 0.0 1 0 2
## 96 53 1 0 142 226 0 0 111 1 0.0 2 0 3
## 98 52 1 0 108 233 1 1 147 0 0.1 2 3 3
## 99 43 1 2 130 315 0 1 162 0 1.9 2 1 2
## 100 53 1 2 130 246 1 0 173 0 0.0 2 3 2
## 101 42 1 3 148 244 0 0 178 0 0.8 2 2 2
## 103 63 0 1 140 195 0 1 179 0 0.0 2 2 2
## 104 42 1 2 120 240 1 1 194 0 0.8 0 0 3
## 105 50 1 2 129 196 0 1 163 0 0.0 2 0 2
## 106 68 0 2 120 211 0 0 115 0 1.5 1 0 2
## 107 69 1 3 160 234 1 0 131 0 0.1 1 1 2
## 108 45 0 0 138 236 0 0 152 1 0.2 1 0 2
## 109 50 0 1 120 244 0 1 162 0 1.1 2 0 2
## 110 50 0 0 110 254 0 0 159 0 0.0 2 0 2
## 112 57 1 2 150 126 1 1 173 0 0.2 2 1 3
## 113 64 0 2 140 313 0 1 133 0 0.2 2 0 3
## 114 43 1 0 110 211 0 1 161 0 0.0 2 0 3
## 115 55 1 1 130 262 0 1 155 0 0.0 2 0 2
## 116 37 0 2 120 215 0 1 170 0 0.0 2 0 2
## 117 41 1 2 130 214 0 0 168 0 2.0 1 0 2
## 118 56 1 3 120 193 0 0 162 0 1.9 1 0 3
## 119 46 0 1 105 204 0 1 172 0 0.0 2 0 2
## 120 46 0 0 138 243 0 0 152 1 0.0 1 0 2
## 121 64 0 0 130 303 0 1 122 0 2.0 1 2 2
## 122 59 1 0 138 271 0 0 182 0 0.0 2 0 2
## 123 41 0 2 112 268 0 0 172 1 0.0 2 0 2
## 124 54 0 2 108 267 0 0 167 0 0.0 2 0 2
## 125 39 0 2 94 199 0 1 179 0 0.0 2 0 2
## 126 34 0 1 118 210 0 1 192 0 0.7 2 0 2
## 127 47 1 0 112 204 0 1 143 0 0.1 2 0 2
## 128 67 0 2 152 277 0 1 172 0 0.0 2 1 2
## 129 52 0 2 136 196 0 0 169 0 0.1 1 0 2
## 130 74 0 1 120 269 0 0 121 1 0.2 2 1 2
## 131 54 0 2 160 201 0 1 163 0 0.0 2 1 2
## 132 49 0 1 134 271 0 1 162 0 0.0 1 0 2
## 133 42 1 1 120 295 0 1 162 0 0.0 2 0 2
## 134 41 1 1 110 235 0 1 153 0 0.0 2 0 2
## 135 41 0 1 126 306 0 1 163 0 0.0 2 0 2
## 136 49 0 0 130 269 0 1 163 0 0.0 2 0 2
## 137 60 0 2 120 178 1 1 96 0 0.0 2 0 2
## 138 62 1 1 128 208 1 0 140 0 0.0 2 0 2
## 139 57 1 0 110 201 0 1 126 1 1.5 1 0 1
## 140 64 1 0 128 263 0 1 105 1 0.2 1 1 3
## 141 51 0 2 120 295 0 0 157 0 0.6 2 0 2
## 142 43 1 0 115 303 0 1 181 0 1.2 1 0 2
## 143 42 0 2 120 209 0 1 173 0 0.0 1 0 2
## 144 67 0 0 106 223 0 1 142 0 0.3 2 2 2
## 145 76 0 2 140 197 0 2 116 0 1.1 1 0 2
## 146 70 1 1 156 245 0 0 143 0 0.0 2 0 2
## 147 44 0 2 118 242 0 1 149 0 0.3 1 1 2
## 148 60 0 3 150 240 0 1 171 0 0.9 2 0 2
## 149 44 1 2 120 226 0 1 169 0 0.0 2 0 2
## 150 42 1 2 130 180 0 1 150 0 0.0 2 0 2
## 151 66 1 0 160 228 0 0 138 0 2.3 2 0 1
## 152 71 0 0 112 149 0 1 125 0 1.6 1 0 2
## 153 64 1 3 170 227 0 0 155 0 0.6 1 0 3
## 154 66 0 2 146 278 0 0 152 0 0.0 1 1 2
## 155 39 0 2 138 220 0 1 152 0 0.0 1 0 2
## 156 58 0 0 130 197 0 1 131 0 0.6 1 0 2
## 157 47 1 2 130 253 0 1 179 0 0.0 2 0 2
## 158 35 1 1 122 192 0 1 174 0 0.0 2 0 2
## 159 58 1 1 125 220 0 1 144 0 0.4 1 4 3
## 160 56 1 1 130 221 0 0 163 0 0.0 2 0 3
## 161 56 1 1 120 240 0 1 169 0 0.0 0 0 2
## 162 55 0 1 132 342 0 1 166 0 1.2 2 0 2
## 163 41 1 1 120 157 0 1 182 0 0.0 2 0 2
## 164 38 1 2 138 175 0 1 173 0 0.0 2 4 2
## 166 67 1 0 160 286 0 0 108 1 1.5 1 3 2
## 167 67 1 0 120 229 0 0 129 1 2.6 1 2 3
## 168 62 0 0 140 268 0 0 160 0 3.6 0 2 2
## 169 63 1 0 130 254 0 0 147 0 1.4 1 1 3
## 170 53 1 0 140 203 1 0 155 1 3.1 0 0 3
## 171 56 1 2 130 256 1 0 142 1 0.6 1 1 1
## 172 48 1 1 110 229 0 1 168 0 1.0 0 0 3
## 173 58 1 1 120 284 0 0 160 0 1.8 1 0 2
## 174 58 1 2 132 224 0 0 173 0 3.2 2 2 3
## 175 60 1 0 130 206 0 0 132 1 2.4 1 2 3
## 176 40 1 0 110 167 0 0 114 1 2.0 1 0 3
## 177 60 1 0 117 230 1 1 160 1 1.4 2 2 3
## 178 64 1 2 140 335 0 1 158 0 0.0 2 0 2
## 179 43 1 0 120 177 0 0 120 1 2.5 1 0 3
## 180 57 1 0 150 276 0 0 112 1 0.6 1 1 1
## 181 55 1 0 132 353 0 1 132 1 1.2 1 1 3
## 182 65 0 0 150 225 0 0 114 0 1.0 1 3 3
## 183 61 0 0 130 330 0 0 169 0 0.0 2 0 2
## 184 58 1 2 112 230 0 0 165 0 2.5 1 1 3
## 185 50 1 0 150 243 0 0 128 0 2.6 1 0 3
## 186 44 1 0 112 290 0 0 153 0 0.0 2 1 2
## 187 60 1 0 130 253 0 1 144 1 1.4 2 1 3
## 188 54 1 0 124 266 0 0 109 1 2.2 1 1 3
## 189 50 1 2 140 233 0 1 163 0 0.6 1 1 3
## 190 41 1 0 110 172 0 0 158 0 0.0 2 0 3
## 191 51 0 0 130 305 0 1 142 1 1.2 1 0 3
## 192 58 1 0 128 216 0 0 131 1 2.2 1 3 3
## 193 54 1 0 120 188 0 1 113 0 1.4 1 1 3
## 194 60 1 0 145 282 0 0 142 1 2.8 1 2 3
## 195 60 1 2 140 185 0 0 155 0 3.0 1 0 2
## 196 59 1 0 170 326 0 0 140 1 3.4 0 0 3
## 197 46 1 2 150 231 0 1 147 0 3.6 1 0 2
## 198 67 1 0 125 254 1 1 163 0 0.2 1 2 3
## 199 62 1 0 120 267 0 1 99 1 1.8 1 2 3
## 200 65 1 0 110 248 0 0 158 0 0.6 2 2 1
## 201 44 1 0 110 197 0 0 177 0 0.0 2 1 2
## 202 60 1 0 125 258 0 0 141 1 2.8 1 1 3
## 203 58 1 0 150 270 0 0 111 1 0.8 2 0 3
## 205 62 0 0 160 164 0 0 145 0 6.2 0 3 3
## 206 52 1 0 128 255 0 1 161 1 0.0 2 1 3
## 207 59 1 0 110 239 0 0 142 1 1.2 1 1 3
## 208 60 0 0 150 258 0 0 157 0 2.6 1 2 3
## 209 49 1 2 120 188 0 1 139 0 2.0 1 3 3
## 210 59 1 0 140 177 0 1 162 1 0.0 2 1 3
## 211 57 1 2 128 229 0 0 150 0 0.4 1 1 3
## 212 61 1 0 120 260 0 1 140 1 3.6 1 1 3
## 213 39 1 0 118 219 0 1 140 0 1.2 1 0 3
## 214 61 0 0 145 307 0 0 146 1 1.0 1 0 3
## 215 56 1 0 125 249 1 0 144 1 1.2 1 1 2
## 216 43 0 0 132 341 1 0 136 1 3.0 1 0 3
## 217 62 0 2 130 263 0 1 97 0 1.2 1 1 3
## 218 63 1 0 130 330 1 0 132 1 1.8 2 3 3
## 219 65 1 0 135 254 0 0 127 0 2.8 1 1 3
## 220 48 1 0 130 256 1 0 150 1 0.0 2 2 3
## 222 55 1 0 140 217 0 1 111 1 5.6 0 0 3
## 223 65 1 3 138 282 1 0 174 0 1.4 1 1 2
## 225 54 1 0 110 239 0 1 126 1 2.8 1 1 3
## 226 70 1 0 145 174 0 1 125 1 2.6 0 0 3
## 227 62 1 1 120 281 0 0 103 0 1.4 1 1 3
## 228 35 1 0 120 198 0 1 130 1 1.6 1 0 3
## 229 59 1 3 170 288 0 0 159 0 0.2 1 0 3
## 230 64 1 2 125 309 0 1 131 1 1.8 1 0 3
## 231 47 1 2 108 243 0 1 152 0 0.0 2 0 2
## 232 57 1 0 165 289 1 0 124 0 1.0 1 3 3
## 233 55 1 0 160 289 0 0 145 1 0.8 1 1 3
## 234 64 1 0 120 246 0 0 96 1 2.2 0 1 2
## 235 70 1 0 130 322 0 0 109 0 2.4 1 3 2
## 236 51 1 0 140 299 0 1 173 1 1.6 2 0 3
## 237 58 1 0 125 300 0 0 171 0 0.0 2 2 3
## 238 60 1 0 140 293 0 0 170 0 1.2 1 2 3
## 239 77 1 0 125 304 0 0 162 1 0.0 2 3 2
## 240 35 1 0 126 282 0 0 156 1 0.0 2 0 3
## 241 70 1 2 160 269 0 1 112 1 2.9 1 1 3
## 243 64 1 0 145 212 0 0 132 0 2.0 1 2 1
## 244 57 1 0 152 274 0 1 88 1 1.2 1 1 3
## 245 56 1 0 132 184 0 0 105 1 2.1 1 1 1
## 246 48 1 0 124 274 0 0 166 0 0.5 1 0 3
## 248 66 1 1 160 246 0 1 120 1 0.0 1 3 1
## 250 69 1 2 140 254 0 0 146 0 2.0 1 3 3
## 251 51 1 0 140 298 0 1 122 1 4.2 1 3 3
## 252 43 1 0 132 247 1 0 143 1 0.1 1 4 3
## 253 62 0 0 138 294 1 1 106 0 1.9 1 3 2
## 254 67 1 0 100 299 0 0 125 1 0.9 1 2 2
## 255 59 1 3 160 273 0 0 125 0 0.0 2 0 2
## 256 45 1 0 142 309 0 0 147 1 0.0 1 3 3
## 257 58 1 0 128 259 0 0 130 1 3.0 1 2 3
## 258 50 1 0 144 200 0 0 126 1 0.9 1 0 3
## 259 62 0 0 150 244 0 1 154 1 1.4 1 0 2
## 260 38 1 3 120 231 0 1 182 1 3.8 1 0 3
## 262 52 1 0 112 230 0 1 160 0 0.0 2 1 2
## 263 53 1 0 123 282 0 1 95 1 2.0 1 2 3
## 264 63 0 0 108 269 0 1 169 1 1.8 1 2 2
## 265 54 1 0 110 206 0 0 108 1 0.0 1 1 2
## 266 66 1 0 112 212 0 0 132 1 0.1 2 1 2
## 268 49 1 2 118 149 0 0 126 0 0.8 2 3 2
## 269 54 1 0 122 286 0 0 116 1 3.2 1 2 2
## 270 56 1 0 130 283 1 0 103 1 1.6 0 0 3
## 271 46 1 0 120 249 0 0 144 0 0.8 2 0 3
## 272 61 1 3 134 234 0 1 145 0 2.6 1 2 2
## 274 58 1 0 100 234 0 1 156 0 0.1 2 1 3
## 275 47 1 0 110 275 0 0 118 1 1.0 1 1 2
## 276 52 1 0 125 212 0 1 168 0 1.0 2 2 3
## 277 58 1 0 146 218 0 1 105 0 2.0 1 1 3
## 278 57 1 1 124 261 0 1 141 0 0.3 2 0 3
## 279 58 0 1 136 319 1 0 152 0 0.0 2 2 2
## 280 61 1 0 138 166 0 0 125 1 3.6 1 1 2
## 281 42 1 0 136 315 0 1 125 1 1.8 1 0 1
## 282 52 1 0 128 204 1 1 156 1 1.0 1 0 0
## 283 59 1 2 126 218 1 1 134 0 2.2 1 1 1
## 284 40 1 0 152 223 0 1 181 0 0.0 2 0 3
## 285 61 1 0 140 207 0 0 138 1 1.9 2 1 3
## 286 46 1 0 140 311 0 1 120 1 1.8 1 2 3
## 287 59 1 3 134 204 0 1 162 0 0.8 2 2 2
## 288 57 1 1 154 232 0 0 164 0 0.0 2 1 2
## 289 57 1 0 110 335 0 1 143 1 3.0 1 1 3
## 290 55 0 0 128 205 0 2 130 1 2.0 1 1 3
## 291 61 1 0 148 203 0 1 161 0 0.0 2 1 3
## 292 58 1 0 114 318 0 2 140 0 4.4 0 3 1
## 293 58 0 0 170 225 1 0 146 1 2.8 1 2 1
## 294 67 1 2 152 212 0 0 150 0 0.8 1 0 3
## 295 44 1 0 120 169 0 1 144 1 2.8 0 0 1
## 296 63 1 0 140 187 0 0 144 1 4.0 2 2 3
## 297 63 0 0 124 197 0 1 136 1 0.0 1 0 2
## 298 59 1 0 164 176 1 0 90 0 1.0 1 2 1
## 299 57 0 0 140 241 0 1 123 1 0.2 1 0 3
## 300 45 1 3 110 264 0 1 132 0 1.2 1 0 3
## 301 68 1 0 144 193 1 1 141 0 3.4 1 2 3
## 302 57 1 0 130 131 0 1 115 1 1.2 1 1 3
## 303 57 0 1 130 236 0 0 174 0 0.0 1 1 2
## output
## 1 1
## 2 1
## 3 1
## 4 1
## 5 1
## 6 1
## 7 1
## 8 1
## 10 1
## 11 1
## 12 1
## 13 1
## 14 1
## 15 1
## 16 1
## 17 1
## 18 1
## 19 1
## 20 1
## 21 1
## 22 1
## 23 1
## 24 1
## 25 1
## 26 1
## 27 1
## 28 1
## 30 1
## 31 1
## 32 1
## 33 1
## 34 1
## 35 1
## 36 1
## 37 1
## 38 1
## 39 1
## 40 1
## 41 1
## 42 1
## 43 1
## 44 1
## 45 1
## 46 1
## 47 1
## 48 1
## 49 1
## 50 1
## 51 1
## 52 1
## 53 1
## 54 1
## 55 1
## 56 1
## 57 1
## 58 1
## 59 1
## 60 1
## 61 1
## 62 1
## 63 1
## 64 1
## 65 1
## 66 1
## 67 1
## 68 1
## 69 1
## 70 1
## 71 1
## 72 1
## 73 1
## 74 1
## 75 1
## 76 1
## 77 1
## 78 1
## 79 1
## 80 1
## 81 1
## 82 1
## 83 1
## 84 1
## 85 1
## 87 1
## 88 1
## 89 1
## 90 1
## 91 1
## 92 1
## 93 1
## 94 1
## 95 1
## 96 1
## 98 1
## 99 1
## 100 1
## 101 1
## 103 1
## 104 1
## 105 1
## 106 1
## 107 1
## 108 1
## 109 1
## 110 1
## 112 1
## 113 1
## 114 1
## 115 1
## 116 1
## 117 1
## 118 1
## 119 1
## 120 1
## 121 1
## 122 1
## 123 1
## 124 1
## 125 1
## 126 1
## 127 1
## 128 1
## 129 1
## 130 1
## 131 1
## 132 1
## 133 1
## 134 1
## 135 1
## 136 1
## 137 1
## 138 1
## 139 1
## 140 1
## 141 1
## 142 1
## 143 1
## 144 1
## 145 1
## 146 1
## 147 1
## 148 1
## 149 1
## 150 1
## 151 1
## 152 1
## 153 1
## 154 1
## 155 1
## 156 1
## 157 1
## 158 1
## 159 1
## 160 1
## 161 1
## 162 1
## 163 1
## 164 1
## 166 0
## 167 0
## 168 0
## 169 0
## 170 0
## 171 0
## 172 0
## 173 0
## 174 0
## 175 0
## 176 0
## 177 0
## 178 0
## 179 0
## 180 0
## 181 0
## 182 0
## 183 0
## 184 0
## 185 0
## 186 0
## 187 0
## 188 0
## 189 0
## 190 0
## 191 0
## 192 0
## 193 0
## 194 0
## 195 0
## 196 0
## 197 0
## 198 0
## 199 0
## 200 0
## 201 0
## 202 0
## 203 0
## 205 0
## 206 0
## 207 0
## 208 0
## 209 0
## 210 0
## 211 0
## 212 0
## 213 0
## 214 0
## 215 0
## 216 0
## 217 0
## 218 0
## 219 0
## 220 0
## 222 0
## 223 0
## 225 0
## 226 0
## 227 0
## 228 0
## 229 0
## 230 0
## 231 0
## 232 0
## 233 0
## 234 0
## 235 0
## 236 0
## 237 0
## 238 0
## 239 0
## 240 0
## 241 0
## 243 0
## 244 0
## 245 0
## 246 0
## 248 0
## 250 0
## 251 0
## 252 0
## 253 0
## 254 0
## 255 0
## 256 0
## 257 0
## 258 0
## 259 0
## 260 0
## 262 0
## 263 0
## 264 0
## 265 0
## 266 0
## 268 0
## 269 0
## 270 0
## 271 0
## 272 0
## 274 0
## 275 0
## 276 0
## 277 0
## 278 0
## 279 0
## 280 0
## 281 0
## 282 0
## 283 0
## 284 0
## 285 0
## 286 0
## 287 0
## 288 0
## 289 0
## 290 0
## 291 0
## 292 0
## 293 0
## 294 0
## 295 0
## 296 0
## 297 0
## 298 0
## 299 0
## 300 0
## 301 0
## 302 0
## 303 0
# Normalizamos todas las columnas de heart_clean excepto la columna 'output' (si existe)
heart_clean_n<-heart_clean
if ("output" %in% colnames(heart_clean_n)) {
output_column <- heart_clean_n$output # Guarda la columna 'output'
heart_clean_n <- heart_clean_n[, !names(heart_clean_n) %in% "output"] # Elimina la columna 'output' para normalizar
}
# Convertir todas las columnas a tipo numérico
heart_clean_numeric <- as.data.frame(lapply(heart_clean_n, as.numeric))
# Normalizamos los datos
heart_norm <- as.data.frame(scale(heart_clean_numeric))
# Agregamos la columna 'output'
if (exists("output_column")) {
heart_norm$output <- output_column
}
Calculamos las varianzas de las variables numéricas ‘age’, ‘trtbps’, ‘chol’, ‘thalachh’, y ‘oldpeak’, del conjunto, agrupadas según la probabilidad de sufrir o no un infarto.
# Calculamos la varianza para cada variable según los niveles de 'output'
for (variable in variables) {
var_por_output <- tapply(heart_norm[[variable]], heart_norm$output, var)
mensaje <- paste("Varianza de", variable, "según 'output':")
print(mensaje)
print(var_por_output)
}
## [1] "Varianza de age según 'output':"
## 0 1
## 0.7855903 1.0895781
## [1] "Varianza de trtbps según 'output':"
## 0 1
## 1.0385980 0.9477493
## [1] "Varianza de chol según 'output':"
## 0 1
## 1.0628628 0.9347773
## [1] "Varianza de thalachh según 'output':"
## 0 1
## 0.9162405 0.7388003
## [1] "Varianza de oldpeak según 'output':"
## 0 1
## 1.2811090 0.4191531
# Variables a analizar
variables <- c('age', 'trtbps', 'chol', 'thalachh', 'oldpeak')
# Calculamos la varianza para cada variable según los niveles de 'output'
resultados_var <- aggregate(. ~ output, data = heart_norm[, c('output', variables)], var)
print(resultados_var)
## output age trtbps chol thalachh oldpeak
## 1 0 0.7855903 1.0385980 1.0628628 0.9162405 1.2811090
## 2 1 1.0895781 0.9477493 0.9347773 0.7388003 0.4191531
Estos resultado muestran la media de cada variable numérica (normalizada) para dos grupos distintos definidos por los niveles ‘0’ y ‘1’ de la variable ‘output’, los cuales indican menor o mayor probabilidad de ataque cardíaco.
Primero discretizaremos las variables categóricas, asignando a cada valor la correspondiente definición de la variable
# Hacemos cópia del conjunto para usarlo solamente en este análisis:
heart_discr<-heart_clean
# Sexo del paciente (sex)
heart_discr$sex <- ifelse(heart_discr$sex == 0, "Mujer", "Hombre")
# Dolor Torácico (cp)
heart_discr$cp <- factor(heart_discr$cp, levels = c(1, 2, 3, 4), labels = c("Angina Típica", "Angina Atípica", "No Anginal", "Asintomático"))
# Resultados del Electrocardiograma en Reposo (restecg)
heart_discr$restecg <- factor(heart_discr$restecg, levels = c(0, 1, 2), labels = c("Normal", "Anomalías ST-T", "Hipertrofia ventricular"))
# Angina Inducida por Esfuerzo (exng)
heart_discr$exng <- ifelse(heart_discr$exng == 1, "Si", "No")
# Número de Buques Principales (caa) (0-3)
heart_discr$caa <- as.character(heart_discr$caa)
# Glucemia en Ayunas (fbs)
heart_discr$fbs <- ifelse(heart_discr$fbs == 1, "Verdadero", "Falso")
# Pendiente del Segmento ST Máximo del Ejercicio (slp)
heart_discr$slp <- factor(heart_discr$slp, levels = c(0, 1, 2), labels = c("Tipo 0", "Tipo 1", "Tipo 2"))
# Tasa de Mortalidad (thall)
heart_discr$thall <- factor(heart_discr$thall, levels = c(0, 1, 2, 3), labels = c("Thal0", "Thal1", "Thal2", "Thal3"))
# Ouput/Target (0= menor probabilidad de infarto 1= mayor probabilidad de infarto)
heart_discr$output <- factor(heart_discr$output, levels = c(0, 1), labels = c("Menor probabilidad", "Mayor probabilidad"))
A continuación estudiamos la estadística básica de las variables categóricas del conjunto heart
library(dplyr)
library(ggplot2)
par(mfrow = c(2, 2))
categorical_var <- list("sex", "cp", "fbs", "restecg", "exng", "slp", "caa", "thall")
for (i in categorical_var) {
plot_data <- as.data.frame(table(heart_discr[[i]], heart_discr$output))
colnames(plot_data) <- c(i, "output", "Freq")
plot <- ggplot(plot_data, aes_string(x = i, y = "Freq", fill = "output")) +
geom_bar(stat = "identity", position = position_dodge()) +
scale_fill_manual(values = c("#BA55D3", "#6699CC"),
name = "Probabilidad de Infarto",
labels = c('0-Menor', '1-Mayor')) +
labs(x = i, y = "Número de Observaciones") +
theme_minimal() + # Cambio de tema a minimal
theme(panel.background = element_rect(fill = "white"), # Fondo blanco
axis.line = element_line(color = "black")) # Líneas de ejes negras
print(plot)
}
## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Observaciones
Según el thall, el riesgo de infarto se alcanza en las personas con frecuencia cardíaca máxima(clase 2). En la característica sexo, la clase 1 tiene más posibilidades de sufrir un infarto que la clase 0.
Las probabilidades de sufrir un infarto son mayores en la clase 0 de sexo.
Comparando con el análisis de correlación, la característica fbs muestra la menor correlación con la salida.
En caa, las personas con clase, son más propensas a sufrir un ataque al corazón que las personas con clase 4, 3 y 2.
Según la característica cp, las personas con dolor no anginoso tienen más probabilidades de sufrir un infarto que las personas con dolor anginoso atípico y típico.
En exng, las personas con clase 1 tienen altas probabilidades de riesgo de infarto, mientras que las personas con clase 0 son menos propensas al infarto.
La característica Slp muestra que la clase 0 tiene menos correlación con el resultado que las clases 1 y 2.
A continuación estudiamos la estadística básica de las variables numéricas del conjunto
# Creamos un gráfico de pares con las variables numéricas del conjunto de datos "heart"
# Establecer opciones para el tamaño del gráfico
options(repr.plot.width = 20, repr.plot.height = 20)
# Creamos un gráfico de pares con las variables numéricas del conjunto de datos "heart"
pair_plot <- ggpairs(heart_clean, columns = c("age", "trtbps", "chol", "thalachh", "oldpeak"),
aes(color = as.factor(output), alpha = 0.5),
lower = list(continuous = "smooth"),
palette = c('blue', 'red')) + # Usamos la misma paleta de colores
theme_bw() +
theme(text = element_text(size = 8),
panel.grid = element_blank(),
legend.position = "right",
legend.title = element_text(face = "bold")) +
ggtitle("Variables Numéricas") +
labs(color = "Output", alpha = "Transparencia")
## Warning in warn_if_args_exist(list(...)): Extra arguments: 'palette' are being
## ignored. If these are meant to be aesthetics, submit them using the 'mapping'
## variable within ggpairs with ggplot2::aes or ggplot2::aes_string.
# Convertimos el gráfico a un gráfico interactivo con plotly
interactive_plot <- ggplotly(pair_plot)
## Warning: Can only have one: highlight
## Warning: Can only have one: highlight
## Warning: Can only have one: highlight
## Warning: Can only have one: highlight
# Mostramos el gráfico interactivo
interactive_plot
Un modelo no supervisado de clustering busca agrupar datos similares en conjuntos o clústeres. En este caso, la distancia Manhattan es una medida de distancia utilizada en clustering para calcular la diferencia entre dos puntos en un espacio multidimensional.
En este caso, puede ser útil para la identificación de subgrupos de pacientes con perfiles de riesgo similares de enfermedad cardíaca, lo que podría ser útil para personalizar tratamientos, identificar factores de riesgo comunes o incluso guiar futuras investigaciones médicas.
Para poder aplicar el logaritmo, escalamos los datos y mostramos el dendograma para saber donde determinar el corte y escoger el número de clústers.
heart_norm <- as.data.frame(sapply(heart_norm, as.numeric))
# Escalamos los datos
heart_scale<-scale(heart_norm)
#Calculamos la distancia manhattan
dist_manh<-dist(heart_scale, method = 'manhattan')
#A continuación usamos la variable creada para minimizar las diferencias dentro de los conglomerados mediante el método Ward
hcluster<-hclust(dist_manh, method = "ward.D")
hcluster
##
## Call:
## hclust(d = dist_manh, method = "ward.D")
##
## Cluster method : ward.D
## Distance : manhattan
## Number of objects: 287
library(dendextend)
##
## ---------------------
## Welcome to dendextend version 1.17.1
## Type citation('dendextend') for how to cite the package.
##
## Type browseVignettes(package = 'dendextend') for the package vignette.
## The github page is: https://github.com/talgalili/dendextend/
##
## Suggestions and bug-reports can be submitted at: https://github.com/talgalili/dendextend/issues
## You may ask questions at stackoverflow, use the r and dendextend tags:
## https://stackoverflow.com/questions/tagged/dendextend
##
## To suppress this message use: suppressPackageStartupMessages(library(dendextend))
## ---------------------
##
## Attaching package: 'dendextend'
## The following object is masked from 'package:stats':
##
## cutree
dendo<-as.dendrogram(hcluster)
dendo_k<-find_k(dendo)
plot(dendo_k)
# Observamos como el número de clusters obtenido es 2
plot(color_branches(dendo,k=dendo_k$nc)) #Hemos obtenido que el nombre de clusters será 2
# Creamos la matriz de confusión
grupos<-cutree(hcluster,k=2)
table(grupos,heart_clean$output)
##
## grupos 0 1
## 1 121 37
## 2 8 121
Mediante la matriz de confusión creada, extraeremos el número de casos que se han clasificado correctamente y el porcentaje de precisión del modelo
cat("Número de observaciones clasificadas correctamente =",121+121, "\n")
## Número de observaciones clasificadas correctamente = 242
cat("Número de observaciones clasificadas incorrectamente =", 8+37, "\n")
## Número de observaciones clasificadas incorrectamente = 45
cat("Precisión del modelo:",(242/(242+45))*100, "%\n")
## Precisión del modelo: 84.32056 %
La precisión del modelo es de un 84.32%.
A continuación, visualizamos el cluster con la función fviz_cluster:
library(cluster)
library(factoextra)
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
pam.res <- pam(heart_scale, 2)
fviz_cluster(pam.res, geom = "point", ellipse.type = "norm",
show.clust.cent = TRUE,star.plot = TRUE)+
labs(title = "Resultados clustering K-means")+ theme_bw()
Con una precisión del modelo del 84.33%, se puede decir que este modelo de clasificación logra predecir correctamente alrededor del 84% de los casos en el conjunto de datos evaluado. Esto indica una capacidad razonablemente buena para predecir la enfermedad cardíaca en función de las características utilizadas en el modelo. Sin embargo, en un futuro también sería valioso evaluar otras métricas de rendimiento para obtener una comprensión más completa de su eficacia, como la sensibilidad, la especificidad u otras métricas según el contexto médico específico.
Este análisis busca entender cómo diferentes variables pueden influir en una variable de salida específica. En este caso, se trata de predecir un cierto resultado,es decir, si alguien tiene cierta enfermedad cardíaca o no (ouput).
# Codificamos la variable objetivo como factor
heart_clean$output <- factor(heart_clean$output)
heart_clean <- as.data.frame(sapply(heart_clean, as.numeric))
# Reemplazamos los valores 2 por 0 en la columna "output"
heart_clean$output[heart_clean$output == 1] <- 0
heart_clean$output[heart_clean$output == 2] <- 1
# Dividimos el conjunto de datos en conjunto de entrenamiento y conjunto de prueba
library(caTools)
set.seed(123)
split = sample.split(heart_clean$output, SplitRatio = 0.75)
training_set = subset(heart_clean, split == TRUE)
test_set = subset(heart_clean, split == FALSE)
# Escalamos de características
training_set[-14] = scale(training_set[-14])
test_set[-14] = scale(test_set[-14])
# Ajustamos la regresión logística al conjunto de entrenamiento
classifier = glm(formula = output ~ age+ sex + cp + trtbps+chol+fbs+restecg+thalachh+exng+oldpeak+slp+caa+thall,
family = binomial,
data = training_set)
summary(classifier)
##
## Call:
## glm(formula = output ~ age + sex + cp + trtbps + chol + fbs +
## restecg + thalachh + exng + oldpeak + slp + caa + thall,
## family = binomial, data = training_set)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.196009 0.217916 0.899 0.368402
## age 0.028971 0.266135 0.109 0.913314
## sex -0.844252 0.262799 -3.213 0.001316 **
## cp 0.784661 0.228264 3.438 0.000587 ***
## trtbps -0.213332 0.228084 -0.935 0.349623
## chol -0.455822 0.252511 -1.805 0.071050 .
## fbs 0.009286 0.217132 0.043 0.965889
## restecg 0.393506 0.213860 1.840 0.065766 .
## thalachh 0.532906 0.292425 1.822 0.068399 .
## exng -0.287279 0.238710 -1.203 0.228796
## oldpeak -0.726294 0.302640 -2.400 0.016401 *
## slp 0.494799 0.255935 1.933 0.053199 .
## caa -0.666232 0.237150 -2.809 0.004965 **
## thall -0.549061 0.211196 -2.600 0.009328 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 296.00 on 214 degrees of freedom
## Residual deviance: 148.91 on 201 degrees of freedom
## AIC: 176.91
##
## Number of Fisher Scoring iterations: 6
# Predecimos los resultados del conjunto de prueba
prob_pred = predict(classifier, type = 'response', newdata = test_set[-14])
y_pred = ifelse(prob_pred > 0.5, 1, 0)
# Creamos la Matriz de Confusión
cm = table(test_set[, 14], y_pred > 0.5)
El modelo de regresión logística fue construido para predecir la probabilidad de ocurrencia de enfermedades cardíacas (output) en función de varias variables predictoras (age, sex, cp, trtbps, chol, fbs, restecg, thalachh, exng, oldpeak, slp, caa, thall).
En resumen, las variables más influyentes para predecir la ocurrencia de enfermedades cardíacas en este modelo son “cp” (Tipo de dolor torácico), “sex” (Género), “caa” (Número de vasos sanguíneos principales) y “thall” (Resultado de prueba de esfuerzo cardíaco).
El AIC del modelo es 176.91, lo que sugiere que este modelo podría mejorar con ajustes adicionales o la inclusión de más variables predictoras. Además, la deviance residual es significativamente menor que la deviance nula, indicando que el modelo con las variables predictoras explica parte de la variabilidad en la variable de salida (enfermedades cardíacas).
La creación y evaluación del modelo de clasificación muestran una precisión del 84.33%, lo que indica una capacidad razonablemente buena para predecir la ocurrencia de enfermedades cardíacas en función de las variables utilizadas. Este nivel de precisión es prometedor y señala la relevancia de las características como predictores de la enfermedad.
Entre estas variables, “cp” (Tipo de dolor torácico), “sex” (Género), “caa” (Número de vasos sanguíneos principales) y “thall” (Resultado de prueba de esfuerzo cardíaco) destacan como las más influyentes para identificar la presencia de enfermedades cardíacas en este contexto.
No obstante, es vital destacar que la evaluación de más métricas de rendimiento, como la sensibilidad y la especificidad, podría proporcionar una imagen más completa de la eficacia del modelo, especialmente en un contexto médico específico. Además, considerar la inclusión de más variables o refinamientos para mejorar el modelo es clave, ya que el AIC sugiere que aún hay espacio para ajustes adicionales.
En cuanto a responder al problema, estos resultados proporcionan una comprensión inicial de qué variables pueden estar relacionadas con las enfermedades cardíacas, pero hay áreas que podrían necesitar más investigación o ajustes adicionales en el modelo. Se pueden formular hipótesis preliminares sobre las variables más influyentes, pero para una respuesta más completa al problema, se requeriría un análisis más detallado y quizás la inclusión de más variables predictoras o datos adicionales.